home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 15 / CU Amiga Magazine's Super CD-ROM 15 (1997)(EMAP Images)(GB)[!][issue 1997-10].iso / CUCD / Graphics / Ghostscript / source / zfileio.c < prev    next >
C/C++ Source or Header  |  1997-05-13  |  19KB  |  783 lines
  1. /* Copyright (C) 1989, 1995, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2.   
  3.   This file is part of Aladdin Ghostscript.
  4.   
  5.   Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6.   or distributor accepts any responsibility for the consequences of using it,
  7.   or for whether it serves any particular purpose or works at all, unless he
  8.   or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9.   License (the "License") for full details.
  10.   
  11.   Every copy of Aladdin Ghostscript must include a copy of the License,
  12.   normally in a plain ASCII text file named PUBLIC.  The License grants you
  13.   the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14.   under certain conditions described in the License.  Among other things, the
  15.   License requires that the copyright notice and this notice be preserved on
  16.   all copies.
  17. */
  18.  
  19. /* zfileio.c */
  20. /* File I/O operators */
  21. #include "ghost.h"
  22. #include "gp.h"
  23. #include "errors.h"
  24. #include "oper.h"
  25. #include "stream.h"
  26. #include "files.h"
  27. #include "store.h"
  28. #include "strimpl.h"            /* for ifilter.h */
  29. #include "ifilter.h"            /* for procedure streams */
  30. #include "gsmatrix.h"            /* for gxdevice.h */
  31. #include "gxdevice.h"
  32. #include "gxdevmem.h"
  33.  
  34. /* Forward references */
  35. private int write_string(P2(ref *, stream *));
  36. private int handle_read_status(P4(int, const ref *, const uint *,
  37.   int (*)(P1(os_ptr))));
  38. private int handle_write_status(P4(int, const ref *, const uint *,
  39.   int (*)(P1(os_ptr))));
  40.  
  41. /* ------ Operators ------ */
  42.  
  43. /* <file> closefile - */
  44. int
  45. zclosefile(register os_ptr op)
  46. {    stream *s;
  47.     check_type(*op, t_file);
  48.     if ( file_is_valid(s, op) )    /* closing a closed file is a no-op */
  49.     {    int status = sclose(s);
  50.         if ( status != 0 )
  51.           { if ( s_is_writing(s) )
  52.               return handle_write_status(status, op, NULL,
  53.                          zclosefile);
  54.             else
  55.               return handle_read_status(status, op, NULL,
  56.                         zclosefile);
  57.           }
  58.     }
  59.     pop(1);
  60.     return 0;
  61. }
  62.  
  63. /* <file> read <int> -true- */
  64. /* <file> read -false- */
  65. private int
  66. zread(register os_ptr op)
  67. {    stream *s;
  68.     int ch;
  69.     check_read_file(s, op);
  70.     ch = sgetc(s);
  71.     if ( ch >= 0 )
  72.     {    push(1);
  73.         make_int(op - 1, ch);
  74.         make_bool(op, 1);
  75.     }
  76.     else if ( ch == EOFC )
  77.         make_bool(op, 0);
  78.     else
  79.         return handle_read_status(ch, op, NULL, zread);
  80.     return 0;
  81. }
  82.  
  83. /* <file> <int> write - */
  84. int
  85. zwrite(register os_ptr op)
  86. {    stream *s;
  87.     byte ch;
  88.     int status;
  89.     check_write_file(s, op - 1);
  90.     check_type(*op, t_integer);
  91.     ch = (byte)op->value.intval;
  92.     status = sputc(s, (byte)ch);
  93.     if ( status >= 0 )
  94.     {    pop(2);
  95.         return 0;
  96.     }
  97.     return handle_write_status(status, op - 1, NULL, zwrite);
  98. }
  99.  
  100. /* <file> <string> readhexstring <substring> <filled_bool> */
  101. private int zreadhexstring_continue(P1(os_ptr));
  102. /* We keep track of the odd digit in the next byte of the string */
  103. /* beyond the bytes already used.  (This is just for convenience; */
  104. /* we could do the same thing by passing 2 state parameters to the */
  105. /* continuation procedure instead of 1.) */
  106. private int
  107. zreadhexstring_at(register os_ptr op, uint start)
  108. {    stream *s;
  109.     uint len, nread;
  110.     byte *str;
  111.     int odd;
  112.     stream_cursor_write cw;
  113.     int status;
  114.     check_read_file(s, op - 1);
  115.     /*check_write_type(*op, t_string);*/    /* done by caller */
  116.     str = op->value.bytes;
  117.     len = r_size(op);
  118.     if ( start < len )
  119.       {    odd = str[start];
  120.         if ( odd > 0xf ) odd = -1;
  121.       }
  122.     else
  123.       odd = -1;
  124.     cw.ptr = str + start - 1;
  125.     cw.limit = str + len - 1;
  126.     for ( ; ; )
  127.     {    status = s_hex_process(&s->cursor.r, &cw, &odd,
  128.                        hex_ignore_garbage);
  129.         if ( status == 1 )    /* filled the string */
  130.           {    ref_assign_inline(op - 1, op);
  131.             make_true(op);
  132.             return 0;
  133.           }
  134.         else if ( status != 0 )        /* error or EOF */
  135.           break;
  136.         /* Didn't fill, keep going. */
  137.         status = spgetc(s);
  138.         if ( status < 0 )
  139.           break;
  140.         sputback(s);
  141.     }
  142.     nread = cw.ptr + 1 - str;
  143.     if ( status != EOFC )
  144.       {    /* Error */
  145.         if ( nread < len )
  146.           str[nread] = (odd < 0 ? 0x10 : odd);
  147.         return handle_read_status(status, op - 1, &nread,
  148.                       zreadhexstring_continue);
  149.       }
  150.     /* Reached end-of-file before filling the string. */
  151.     /* Return an appropriate substring. */
  152.     ref_assign_inline(op - 1, op);
  153.     r_set_size(op - 1, nread);
  154.     make_false(op);
  155.     return 0;
  156. }
  157. private int
  158. zreadhexstring(os_ptr op)
  159. {    check_write_type(*op, t_string);
  160.     if ( r_size(op) > 0 )
  161.       *op->value.bytes = 0x10;
  162.     return zreadhexstring_at(op, 0);
  163. }
  164. /* Continue a readhexstring operation after a callout. */
  165. /* *op is the index within the string. */
  166. private int
  167. zreadhexstring_continue(register os_ptr op)
  168. {    int code;
  169.     check_type(*op, t_integer);
  170.     if ( op->value.intval < 0 || op->value.intval > r_size(op - 1) )
  171.       return_error(e_rangecheck);
  172.     check_write_type(op[-1], t_string);
  173.     code = zreadhexstring_at(op - 1, (uint)op->value.intval);
  174.     if ( code >= 0 )
  175.       pop(1);
  176.     return code;
  177. }
  178.  
  179. /* <file> <string> writehexstring - */
  180. private int zwritehexstring_continue(P1(os_ptr));
  181. private int
  182. zwritehexstring_at(register os_ptr op, uint odd)
  183. {    register stream *s;
  184.     register byte ch;
  185.     register const byte *p;
  186.     register const char _ds *hex_digits = "0123456789abcdef";
  187.     register uint len;
  188.     int status;
  189. #define max_hex 128
  190.     byte buf[max_hex];
  191.     check_write_file(s, op - 1);
  192.     check_read_type(*op, t_string);
  193.     p = op->value.bytes;
  194.     len = r_size(op);
  195.     while ( len )
  196.     {    uint len1 = min(len, max_hex / 2);
  197.         register byte *q = buf;
  198.         uint count = len1;
  199.         ref rbuf;
  200.         do
  201.         {    ch = *p++;
  202.             *q++ = hex_digits[ch >> 4];
  203.             *q++ = hex_digits[ch & 0xf];
  204.         }
  205.         while ( --count );
  206.         r_set_size(&rbuf, (len1 << 1) - odd);
  207.         rbuf.value.bytes = buf + odd;
  208.         status = write_string(&rbuf, s);
  209.         switch ( status )
  210.         {
  211.         default:
  212.             return_error(e_ioerror);
  213.         case 0:
  214.             len -= len1;
  215.             odd = 0;
  216.             continue;
  217.         case INTC:
  218.         case CALLC:
  219.             count = rbuf.value.bytes - buf;
  220.             op->value.bytes += count >> 1;
  221.             r_set_size(op, len - (count >> 1));
  222.             count &= 1;
  223.             return handle_write_status(status, op - 1, &count,
  224.                            zwritehexstring_continue);
  225.         }
  226.     }
  227.     pop(2);
  228.     return 0;
  229. #undef max_hex
  230. }
  231. private int
  232. zwritehexstring(os_ptr op)
  233. {    return zwritehexstring_at(op, 0);
  234. }
  235. /* Continue a writehexstring operation after a callout. */
  236. /* *op is the odd/even hex digit flag for the first byte. */
  237. private int
  238. zwritehexstring_continue(register os_ptr op)
  239. {    int code;
  240.     check_type(*op, t_integer);
  241.     if ( (op->value.intval & ~1) != 0 )
  242.       return_error(e_rangecheck);
  243.     code = zwritehexstring_at(op - 1, (uint)op->value.intval);
  244.     if ( code >= 0 )
  245.       pop(1);
  246.     return code;
  247. }
  248.  
  249. /* <file> <string> readstring <substring> <filled_bool> */
  250. private int zreadstring_continue(P1(os_ptr));
  251. private int
  252. zreadstring_at(register os_ptr op, uint start)
  253. {    stream *s;
  254.     uint len, rlen;
  255.     int status;
  256.     check_read_file(s, op - 1);
  257.     check_write_type(*op, t_string);
  258.     len = r_size(op);
  259.     status = sgets(s, op->value.bytes + start, len - start, &rlen);
  260.     rlen += start;
  261.     switch ( status )
  262.     {
  263.     case EOFC:
  264.     case 0:
  265.         break;
  266.     default:
  267.         return handle_read_status(status, op - 1, &rlen,
  268.                       zreadstring_continue);
  269.     }
  270.     /*
  271.      * The most recent Adobe specification says that readstring
  272.      * must signal a rangecheck if the string length is zero.
  273.      * I can't imagine the motivation for this, but we emulate it.
  274.      * It's safe to check it here, rather than earlier, because if
  275.      * len is zero, sgets will return 0 immediately with rlen = 0.
  276.      */
  277.     if ( len == 0 )
  278.       return_error(e_rangecheck);
  279.     r_set_size(op, rlen);
  280.     op[-1] = *op;
  281.     make_bool(op, (rlen == len ? 1 : 0));
  282.     return 0;
  283. }
  284. private int
  285. zreadstring(os_ptr op)
  286. {    return zreadstring_at(op, 0);
  287. }
  288. /* Continue a readstring operation after a callout. */
  289. /* *op is the index within the string. */
  290. private int
  291. zreadstring_continue(register os_ptr op)
  292. {    int code;
  293.     check_type(*op, t_integer);
  294.     if ( op->value.intval < 0 || op->value.intval > r_size(op - 1) )
  295.       return_error(e_rangecheck);
  296.     code = zreadstring_at(op - 1, (uint)op->value.intval);
  297.     if ( code >= 0 )
  298.       pop(1);
  299.     return code;
  300. }
  301.  
  302. /* <file> <string> writestring - */
  303. private int
  304. zwritestring(register os_ptr op)
  305. {    stream *s;
  306.     int status;
  307.     check_write_file(s, op - 1);
  308.     check_read_type(*op, t_string);
  309.     status = write_string(op, s);
  310.     if ( status >= 0 )
  311.     {    pop(2);
  312.         return 0;
  313.     }
  314.     return handle_write_status(status, op - 1, NULL, zwritestring);
  315. }
  316.  
  317. /* <file> <string> readline <substring> <bool> */
  318. private int zreadline(P1(os_ptr));
  319. private int zreadline_continue(P1(os_ptr));
  320. /*
  321.  * We could handle readline the same way as readstring,
  322.  * except for the anomalous situation where we get interrupted
  323.  * between the CR and the LF of an end-of-line marker.
  324.  * We hack around this in the following way: if we get interrupted
  325.  * before we've read any characters, we just restart the readline;
  326.  * if we get interrupted at any other time, we use readline_continue;
  327.  * we use start=0 (which we have just ruled out as a possible start value
  328.  * for readline_continue) to indicate interruption after the CR.
  329.  */
  330. private int
  331. zreadline_at(register os_ptr op, uint count, bool in_eol)
  332. {    stream *s;
  333.     byte *ptr;
  334.     uint len;
  335.     int status;
  336.     check_read_file(s, op - 1);
  337.     check_write_type(*op, t_string);
  338.     ptr = op->value.bytes;
  339.     len = r_size(op);
  340.     status = zreadline_from(s, ptr, len, &count, &in_eol);
  341.     switch ( status )
  342.     {
  343.     case 0:
  344.     case EOFC:
  345.         break;
  346.     case 1:
  347.         return_error(e_rangecheck);
  348.     default:
  349.         if ( count == 0 && !in_eol )
  350.           return handle_read_status(status, op - 1, NULL,
  351.                         zreadline);
  352.         else
  353.           { if ( in_eol )
  354.               { r_set_size(op, count);
  355.             count = 0;
  356.               }
  357.             return handle_read_status(status, op - 1, &count,
  358.                           zreadline_continue);
  359.         }
  360.     }
  361.     r_set_size(op, count);
  362.     op[-1] = *op;
  363.     make_bool(op, status == 0);
  364.     return 0;
  365. }
  366. private int
  367. zreadline(register os_ptr op)
  368. {    return zreadline_at(op, 0, false);
  369. }
  370. /* Continue a readline operation after a callout. */
  371. /* *op is the index within the string, or 0 for an interrupt after a CR. */
  372. private int
  373. zreadline_continue(register os_ptr op)
  374. {    uint size = r_size(op - 1);
  375.     uint start;
  376.     int code;
  377.  
  378.     check_type(*op, t_integer);
  379.     if ( op->value.intval < 0 || op->value.intval > size )
  380.       return_error(e_rangecheck);
  381.     start = (uint)op->value.intval;
  382.     code = (start == 0 ? zreadline_at(op - 1, size, true) :
  383.         zreadline_at(op - 1, start, false));
  384.     if ( code >= 0 )
  385.       pop(1);
  386.     return code;
  387. }
  388.  
  389. /* Internal readline routine. */
  390. /* Returns a stream status value, or 1 if we overflowed the string. */
  391. /* This is exported for %lineedit. */
  392. int
  393. zreadline_from(stream *s, byte *ptr, uint size, uint *pcount, bool *pin_eol)
  394. {    uint count = *pcount;
  395.  
  396.     /* Most systems define \n as 0xa and \r as 0xd; however, */
  397.     /* OS-9 has \n == \r == 0xd and \l == 0xa.  The following */
  398.     /* code works properly regardless of environment. */
  399. #if '\n' == '\r'
  400. #  define LF 0xa
  401. #else
  402. #  define LF '\n'
  403. #endif
  404.  
  405. top:    if ( *pin_eol )
  406.     {    /*
  407.          * We're in the middle of checking for a two-character
  408.          * end-of-line sequence.  If we get an EOF here, stop, but
  409.          * don't signal EOF now; wait till the next read.
  410.          */
  411.         int ch = spgetcc(s, false);
  412.         if ( ch == EOFC )
  413.           { *pin_eol = false;
  414.             return 0;
  415.           }
  416.         else if ( ch < 0 )
  417.           return ch;
  418.         else if ( ch != LF )
  419.           sputback(s);
  420.         *pin_eol = false;
  421.         return 0;
  422.     }
  423.     for ( ; ; )
  424.     {    int ch = sgetc(s);
  425.         if ( ch < 0 )        /* EOF or exception */
  426.         {    *pcount = count;
  427.             return ch;
  428.         }
  429.  
  430.         switch ( ch )
  431.         {
  432.         case '\r':
  433.           {
  434. #if '\n' == '\r'            /* OS-9 or similar */
  435.             stream *ins;
  436.             int code = zget_stdin(&ins);
  437.             if ( code < 0 || s != ins )
  438. #endif
  439.             {    *pcount = count;
  440.                 *pin_eol = true;
  441.                 goto top;
  442.             }
  443.           }
  444.             /* falls through */
  445.         case LF:
  446. #undef LF
  447.             *pcount = count;
  448.             return 0;
  449.         }
  450.         if ( count >= size )    /* filled the string */
  451.         {    sputback(s);
  452.             *pcount = count;
  453.             return 1;
  454.         }
  455.         ptr[count++] = ch;
  456.     }
  457.     /*return 0;*/        /* not reached */
  458. }
  459.  
  460. /* <file> bytesavailable <int> */
  461. private int
  462. zbytesavailable(register os_ptr op)
  463. {    stream *s;
  464.     long avail;
  465.     check_read_file(s, op);
  466.     switch ( savailable(s, &avail) )
  467.       {
  468.       default:
  469.         return_error(e_ioerror);
  470.       case EOFC:
  471.         avail = -1;
  472.       case 0:
  473.         ;
  474.       }
  475.     make_int(op, avail);
  476.     return 0;
  477. }
  478.  
  479. /* - flush - */
  480. int
  481. zflush(register os_ptr op)
  482. {    stream *s;
  483.     int code = zget_stdout(&s);
  484.     if ( code < 0 )
  485.       return code;
  486.     sflush(s);
  487.     return 0;
  488. }
  489.  
  490. /* <file> flushfile - */
  491. private int
  492. zflushfile(register os_ptr op)
  493. {    stream *s;
  494.     int status;
  495.     check_file(s, op);
  496.     status = sflush(s);
  497.     if ( status == 0 )
  498.     {    pop(1);
  499.         return 0;
  500.     }
  501.     return
  502.       (s_is_writing(s) ?
  503.        handle_write_status(status, op, NULL, zflushfile) :
  504.        handle_read_status(status, op, NULL, zflushfile));
  505. }
  506.  
  507. /* <file> resetfile - */
  508. private int
  509. zresetfile(register os_ptr op)
  510. {    stream *s;
  511.     /* According to Adobe, resetfile is a no-op on closed files. */
  512.     check_type(*op, t_file);
  513.     if ( file_is_valid(s, op) )
  514.       sreset(s);
  515.     pop(1);
  516.     return 0;
  517. }
  518.  
  519. /* <string> print - */
  520. private int
  521. zprint(register os_ptr op)
  522. {    stream *s;
  523.     int status;
  524.     ref rstdout;
  525.     int code;
  526.     check_read_type(*op, t_string);
  527.     code = zget_stdout(&s);
  528.     if ( code < 0 )
  529.       return code;
  530.     status = write_string(op, s);
  531.     if ( status >= 0 )
  532.     {    pop(1);
  533.         return 0;
  534.     }
  535.     /* Convert print to writestring on the fly. */
  536.     make_stream_file(&rstdout, s, "w");
  537.     code = handle_write_status(status, &rstdout, NULL, zwritestring);
  538.     if ( code != o_push_estack )
  539.       return code;
  540.     push(1);
  541.     *op = op[-1];
  542.     op[-1] = rstdout;
  543.     return code;
  544. }
  545.  
  546. /* <bool> echo - */
  547. private int
  548. zecho(register os_ptr op)
  549. {    check_type(*op, t_boolean);
  550.     /****** NOT IMPLEMENTED YET ******/
  551.     pop(1);
  552.     return 0;
  553. }
  554.  
  555. /* ------ Level 2 extensions ------ */
  556.  
  557. /* <file> fileposition <int> */
  558. private int
  559. zfileposition(register os_ptr op)
  560. {    stream *s;
  561.     check_file(s, op);
  562.     make_int(op, stell(s));
  563.     return 0;
  564. }
  565.  
  566. /* <file> <int> setfileposition - */
  567. private int
  568. zsetfileposition(register os_ptr op)
  569. {    stream *s;
  570.     check_file(s, op - 1);
  571.     check_type(*op, t_integer);
  572.     if ( sseek(s, op->value.intval) < 0 )
  573.         return_error(e_ioerror);
  574.     pop(2);
  575.     return 0;
  576. }
  577.  
  578. /* ------ Non-standard extensions ------ */
  579.  
  580. /* <file> <int> unread - */
  581. private int
  582. zunread(register os_ptr op)
  583. {    stream *s;
  584.     ulong ch;
  585.     check_read_file(s, op - 1);
  586.     check_type(*op, t_integer);
  587.     ch = op->value.intval;
  588.     if ( ch > 0xff )
  589.         return_error(e_rangecheck);
  590.     if ( sungetc(s, (byte)ch) < 0 )
  591.         return_error(e_ioerror);
  592.     pop(2);
  593.     return 0;
  594. }
  595.  
  596. /* <file> <object> <==flag> .writecvp - */
  597. private int zwritecvp_continue(P1(os_ptr));
  598. private int
  599. zwritecvp_at(register os_ptr op, uint start)
  600. {    stream *s;
  601. #define max_cvs 128
  602.     byte str[max_cvs];
  603.     ref rstr;
  604.     const byte *pchars = str;
  605.     uint len;
  606.     int code, status;
  607.  
  608.     check_write_file(s, op - 2);
  609.     check_type(*op, t_boolean);
  610.     code = obj_cvp(op - 1, str, max_cvs, &len, &pchars, op->value.boolval);
  611.     if ( code < 0 )
  612.     {    if ( pchars == str )
  613.           return code;
  614.     }
  615.     if ( start > len )
  616.       return_error(e_rangecheck);
  617.     r_set_size(&rstr, len - start);
  618.     rstr.value.const_bytes = pchars + start;
  619.     status = write_string(&rstr, s);
  620.     switch ( status )
  621.     {
  622.     default:
  623.         return_error(e_ioerror);
  624.     case 0:
  625.         break;
  626.     case INTC:
  627.     case CALLC:
  628.         len -= r_size(&rstr);
  629.         return handle_write_status(status, op - 2, &len,
  630.                        zwritecvp_continue);
  631.     }
  632.     pop(3);
  633.     return 0;
  634. #undef max_cvs
  635. }
  636. private int
  637. zwritecvp(os_ptr op)
  638. {    return zwritecvp_at(op, 0);
  639. }
  640. /* Continue a .writecvp after a callout. */
  641. /* *op is the index within the string. */
  642. private int
  643. zwritecvp_continue(os_ptr op)
  644. {    int code;
  645.     check_type(*op, t_integer);
  646.     if ( op->value.intval != (uint)op->value.intval )
  647.       return_error(e_rangecheck);
  648.     code = zwritecvp_at(op - 1, (uint)op->value.intval);
  649.     if ( code >= 0 )
  650.       pop(1);
  651.     return code;
  652. }
  653.  
  654. /* ------ Initialization procedure ------ */
  655.  
  656. BEGIN_OP_DEFS(zfileio_op_defs) {
  657.     {"1bytesavailable", zbytesavailable},
  658.     {"1closefile", zclosefile},
  659.         /* currentfile is in zcontrol.c */
  660.     {"1echo", zecho},
  661.     {"1fileposition", zfileposition},
  662.     {"0flush", zflush},
  663.     {"1flushfile", zflushfile},
  664.     {"1print", zprint},
  665.     {"1read", zread},
  666.     {"2readhexstring", zreadhexstring},
  667.     {"2readline", zreadline},
  668.     {"2readstring", zreadstring},
  669.     {"1resetfile", zresetfile},
  670.     {"2setfileposition", zsetfileposition},
  671.     {"2unread", zunread},
  672.     {"2write", zwrite},
  673.     {"3.writecvp", zwritecvp},
  674.     {"2writehexstring", zwritehexstring},
  675.     {"2writestring", zwritestring},
  676.         /* Internal operators */
  677.     {"3%zreadhexstring_continue", zreadhexstring_continue},
  678.     {"3%zwritehexstring_continue", zwritehexstring_continue},
  679.     {"3%zreadstring_continue", zreadstring_continue},
  680.     {"3%zreadline_continue", zreadline_continue},
  681.     {"4%zwritecvp_continue", zwritecvp_continue},
  682. END_OP_DEFS(0) }
  683.  
  684. /* ------ Non-operator routines ------ */
  685.  
  686. /* Switch a file open for read/write access but currently in write mode */
  687. /* to read mode. */
  688. int
  689. file_switch_to_read(const ref *op)
  690. {    stream *s = fptr(op);
  691.     if ( s->write_id != r_size(op) || s->file == 0 )    /* not valid */
  692.       return_error(e_invalidaccess);
  693.     if ( sswitch(s, false) < 0 )
  694.       return_error(e_ioerror);
  695.     s->read_id = s->write_id;        /* enable reading */
  696.     s->write_id = 0;            /* disable writing */
  697.     return 0;
  698. }
  699.  
  700. /* Switch a file open for read/write access but currently in read mode */
  701. /* to write mode. */
  702. int
  703. file_switch_to_write(const ref *op)
  704. {    stream *s = fptr(op);
  705.     if ( s->read_id != r_size(op) || s->file == 0 )    /* not valid */
  706.       return_error(e_invalidaccess);
  707.     if ( sswitch(s, true) < 0 )
  708.       return_error(e_ioerror);
  709.     s->write_id = s->read_id;        /* enable writing */
  710.     s->read_id = 0;                /* disable reading */
  711.     return 0;
  712. }
  713.  
  714. /* ------ Internal routines ------ */
  715.  
  716. /* Write a string on a file.  The file and string have been validated. */
  717. /* If the status is INTC or CALLC, updates the string on the o-stack. */
  718. private int
  719. write_string(ref *op, stream *s)
  720. {    const byte *data = op->value.const_bytes;
  721.     uint len = r_size(op);
  722.     uint wlen;
  723.     int status = sputs(s, data, len, &wlen);
  724.     switch ( status )
  725.     {
  726.     case INTC:
  727.     case CALLC:
  728.         op->value.const_bytes = data + wlen;
  729.         r_set_size(op, len - wlen);
  730.         /* falls through */
  731.     default:        /* 0, EOFC, ERRC */
  732.         return status;
  733.     }
  734. }
  735.  
  736. /* Handle an exceptional status return from a read stream. */
  737. /* fop points to the ref for the stream. */
  738. /* ch may be any stream exceptional value. */
  739. /* Return 0, 1 (EOF), o_push_estack, or an error. */
  740. private int
  741. handle_read_status(int ch, const ref *fop, const uint *pindex,
  742.   int (*cont)(P1(os_ptr)))
  743. {    switch ( ch )
  744.     {
  745.     default:        /* error */
  746.         return_error(e_ioerror);
  747.     case EOFC:
  748.         return 1;
  749.     case INTC:
  750.     case CALLC:
  751.         if ( pindex )
  752.           { ref index;
  753.             make_int(&index, *pindex);
  754.             return s_handle_read_exception(ch, fop, &index, 1, cont);
  755.           }
  756.         else
  757.           return s_handle_read_exception(ch, fop, NULL, 0, cont);
  758.     }
  759. }
  760.  
  761. /* Handle an exceptional status return from a write stream. */
  762. /* fop points to the ref for the stream. */
  763. /* ch may be any stream exceptional value. */
  764. /* Return 0, o_push_estack, or an error. */
  765. private int
  766. handle_write_status(int ch, const ref *fop, const uint *pindex,
  767.   int (*cont)(P1(os_ptr)))
  768. {    switch ( ch )
  769.     {
  770.     default:        /* error */
  771.         return_error(e_ioerror);
  772.     case INTC:
  773.     case CALLC:
  774.         if ( pindex )
  775.           { ref index;
  776.             make_int(&index, *pindex);
  777.             return s_handle_write_exception(ch, fop, &index, 1, cont);
  778.           }
  779.         else
  780.           return s_handle_write_exception(ch, fop, NULL, 0, cont);
  781.     }
  782. }
  783.